home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / prtcs155.zip / SMSG.REX < prev    next >
OS/2 REXX Batch file  |  1994-01-14  |  10KB  |  297 lines
  1. /**/
  2. v="$VER: Smsg Rexx   Packet Creation for Shelter  Williamson 54.02"
  3. /*
  4.     The  first  parameter is a ECHO TAGNAME. An echomail packet will be
  5.     written and placed in the domains INBOUND directory.
  6.     If the Echo is in a domain other than fidonet use the form:
  7.     echotag@domain
  8. */
  9.  
  10. /* These two are mutually exclusive, if both are set only hardcr    */ 
  11. /* will be effective. If neither set, no processing will be done    */
  12. cvteol=1        /* if 1, CR LF are converted to CR only             */
  13. hardcr=0        /* if 0, hard carriage returns (0dx) will not be    */
  14.                 /* added to the input text file                     */
  15.                 /* if 1, linefeeds are stripped and hard carriage   */
  16.                 /* returns will be added                            */
  17. frompoint99=1   /* if 0, Net/Node will be used in SeenBy and Path   */
  18.                 /* if 1, PointNet/99 is used in SeenBy and Path     */
  19. pointnet=30730  /* if frompoint99=1, then this will be the net used */
  20.                 /* in SeenBy                                        */
  21. doimport=1      /* if 1, import our echomail packets, using the cmd */
  22.                 /* set as IMPPKT                                    */
  23.  
  24. auditdir="OS4:Mback/Inhold"
  25.                 /* If not set to "", all mail created by SMSG       */
  26.                 /* will be copied to this directory                 */
  27.  
  28. options results
  29. options failat 20
  30. signal on syntax  
  31. signal on halt
  32. signal on break_c
  33. signal on break_d
  34. if ~show('L', "rexxsupport.library") then
  35.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  36.         say "Couldn't access support.library !"
  37.         exit 20
  38.     end
  39. sv="v"||right(v,5)
  40. script='Smsg'
  41. if arg()=0 then call usage
  42. log=show('P','ROOFLOG')
  43. wspec='RAW:0/10/640/100/'script sv'/INACTIVE/AUTO/SCREEN'||GetClip('ASYNCSCREEN')
  44. call close('STDOUT'); open('STDOUT',wspec,'w')  
  45. call close('STDIN');call open('STDIN','*','R')
  46. nl='0a'X
  47. cr='0d'X
  48. lf='0a'x
  49. indir=addslash(dequote(GetClip('INDIR')))
  50. mailer=GetClip('SHELTER')
  51. rver=mailer||" v"||GetClip('GENVER')
  52. pvmaj=substr(sv,2,2) ;  pvmin =substr(sv,5,2)
  53. if mailer="ROOF" then def_domain=GetClip('DOMAIN')
  54. else def_domain=GetClip('FTNDOMAIN')
  55. dl=GetClip('DOMAINLIST')
  56.  
  57. parse arg tag infile '"'fromname'"' '"'dsysop'"' subject
  58. infile=strip(infile)
  59. subject=strip(subject)
  60. tag=upper(tag)
  61.  
  62. domidx=lastpos('@',tag)
  63. if domidx ~=0 then do
  64.     ddomain=substr(tag,domidx+1)
  65.     tag=left(tag,(domidx-1))
  66. end;else do
  67.     ddomain=def_domain
  68. end    
  69. call myadr(ddomain)
  70. if frompoint99 then do
  71.     point=99
  72.     fakenet=pointnet'/'point
  73.     ftn_seenby=fakenet
  74.     ftn_path=fakenet
  75. end;else do
  76.     ftn_seenby=net'/'node
  77.     ftn_path=net'/'node
  78. end
  79.  
  80. /* setup dzone,dnet, dnode, dpoint */
  81. destadr=make5d(strip(zone":"net"/"node".0"))
  82.  
  83. singleinbound=GetClip('DOMAINAWARE')=="TRUE"
  84. if singleinbound then pktdir=indir
  85.    else  pktdir=indir||ddomain"/"
  86.  
  87. pktname=pktdir||get_packetname(pktdir)||".PKT"
  88. say 'TagName: 'tag
  89. say 'From:    'fromname
  90. say 'Text:    'infile
  91. say 'Subject: 'subject
  92. if exists(pktname) then do
  93.     call PutLog('Appending to' pktname 'for' destadr,60,10)
  94.     append=1
  95.     pktlen=word(statef(pktname),2)
  96.     if ~open('packet',pktname,'A') then do
  97.         call PutLog("Couldn't append to packet-file" pktname,10,10)
  98.         exit 20
  99.     end
  100.     phdrpos=seek('packet',-2,'E')
  101.     call PutLog('Length:'pktlen'   Pos:'phdrpos,70,70)
  102. end;else do
  103.     call PutLog('Creating ECHO packet' pktname 'for' destadr,60,10)
  104.     append=0
  105.     if ~open('packet',pktname,'W') then do
  106.         call PutLog("Couldn't open packet-file" pktname,10,10)
  107.         exit 20
  108.     end
  109. end
  110.  
  111. tlen=word(statef(infile),2)
  112. if ~open('text',infile,'R') then do
  113.     call PutLog("Couldn't read text file" infile,10,10)
  114.     exit 20
  115. end
  116.  
  117. if append then call PutLog('Appending 'infile'['tlen'] to 'pktname'['pktlen']@['phdrpos']',60,10)
  118.     else call PutLog('Writing 'infile'['tlen'] to 'pktname,60,10)
  119.  
  120. revmaj=d2c(pvmaj);revmin=d2c(pvmin)
  121. d=date("S");t=time("N")
  122. parse var t hh":"mm":"ss
  123. yr=reverse(right("00"x||d2c(left(d,4)),2));mh=reverse(right("00"x||d2c((substr(d,5,2)-1)),2))
  124. dy=reverse(right("00"x||d2c(substr(d,7,2)),2));hr=reverse(right("00"x||d2c(hh),2))
  125. mn=reverse(right("00"x||d2c(mm),2));sc=reverse(right("00"x||d2c(ss),2))
  126. zo=reverse(right("00"x||d2c(zone),2));ndo=reverse(right("00"x||d2c(node),2))
  127. nto=reverse(right("00"x||d2c(net),2));po=reverse(right("00"x||d2c(point),2))
  128. zd=reverse(right("00"x||d2c(dzone),2));ndd=reverse(right("00"x||d2c(dnode),2))
  129. ntd=reverse(right("00"x||d2c(dnet),2));pd=reverse(right("00"x||d2c(dpoint),2))
  130. cw=reverse(right("00"x||"01"x,2));cv=reverse(right("01"x||"00"x,2)) 
  131. if append then phdr=""   
  132. else phdr=ndo||ndd||yr||mh||dy||hr||mn||sc||copies("00"x,2)||"0200"x||nto||ntd||"DA"x||revmaj||copies("00"x, 8)||zo||zd||copies("00"x,2)||cv||"00"x||revmin||cw||zo||zd||po||pd||"ROOF"
  133. phdr=phdr||"0200"x||ndo||ndd||nto||ntd||"00000000"x||left(date(),6) right(date(),2) "" time()||"00"x||dsysop||"00"x||fromname||"00"x||subject||"00"x||"AREA:"||tag||cr
  134. magicnum=x2d(time('s'))+randu(x2d(Pragma('ID')))+(randu(x2d(time('s')))*999999)+(random()*1000000)  
  135. serial=reverse(right("0000"x||c2x(magicnum),8))
  136. phdr=phdr||"01"x||"MSGID: "zone':'net'/'node'.'point'@'bitor(domain,'20'x) serial||cr||"01"x||"PID: "rver||cr
  137. if hardcr then do while ~eof('text')
  138.     phdr=phdr||readln('text')||cr
  139. end;else if cvteol then do
  140.     do while ~eof('text')
  141.         line=readln('text')
  142.         y=pos(cr,line)
  143.         if y ~=0 then phdr=phdr||line
  144.             else phdr=phdr||line||cr
  145.     end
  146.     phdr=phdr||cr
  147. end;else do
  148.     do while ~eof('text')
  149.         phdr=phdr||readch('text',tlen)
  150.     end
  151.     phdr=phdr||cr
  152. end
  153. call close('text')
  154. phdr=phdr||cr||"--- "rver||cr||" * Origin: The Shelter Mailer  ("zone":"net"/"node"."point"@"bitor(domain,'20'x)")"||cr||"SEEN-BY: "||ftn_seenby||cr||"01"x||"PATH: "||ftn_path||cr||"00"x||"0000"x
  155. call writech('packet',phdr)
  156. call close('packet')
  157. f=get_fn(pktname)
  158. note='To:'ddomain'#'dzone':'dnet'/'dnode'.'dpoint 'File:'f
  159. address COMMAND 'FileNote' pktname '"'||note||'"'
  160.  
  161. if auditdir ~="" | auditdir ~=NULL then do
  162.     auditdir=addslash(auditdir)
  163.     address COMMAND 'Copy 'pktname auditdir 'clone'
  164. end
  165.  
  166. if doimport then do
  167.     if mailer="ROOF" then cmd=GetClip('IMPPKT') domain pktname
  168.         else cmd=GetClip('PKTRECD')
  169.     call PutLog('Executing:'cmd,30,10)
  170.     address COMMAND cmd
  171. end
  172. exit
  173.  
  174. get_packetname:
  175. if ~open('out',"CFG:packet_spec",'R') then call PutLog("Can't read packet_spec file",70,10)
  176. else do
  177.     packet_spec=readln('out')
  178.     close('out')
  179. end
  180. tspec=left(date(),2)||compress(time(), ":")
  181. if (tspec=packet_spec) then tspec=tspec+1
  182. do while exists(arg(1)||tspec".PKT") 
  183.     tspec=tspec + 1   
  184. end   
  185. if ~open('out',"CFG:packet_spec",'W') then call PutLog("Can't write new packet_spec file",10,10)
  186. else do
  187.     writeln('out',tspec)
  188.     close('out')
  189. end
  190. return(tspec)
  191.  
  192. /* get filename */
  193. get_fn:
  194. if LastPos('/', arg(1)) ~=0 then return SubStr(arg(1), LastPos('/', arg(1)) + 1)
  195.     else if LastPos(':', arg(1)) ~=0 then return SubStr(arg(1), LastPos(':', arg(1)) + 1)
  196.         else return arg(1)
  197.  
  198. addslash:
  199. curr=arg(1)
  200. select
  201.     when right(curr, 1)=":" then nop
  202.     when right(curr, 1)="/" then nop
  203.         otherwise curr=curr"/"
  204. end
  205. return(curr)
  206.  
  207. make5d: procedure expose dl def_domain ddomain dzone dnet dnode dpoint domain zone net node point
  208.     site_address=arg(1)
  209.     select
  210.         when index(site_address, "#") > 0 then parse var site_address ddomain "#" dzone ":" dnet "/" dnode "." dpoint
  211.         when index(site_address, ":") > 0 then parse var site_address dzone ":" dnet "/" dnode "." dpoint
  212.         when index(site_address, "/") > 0 then parse var site_address dnet "/" dnode "." dpoint
  213.         when index(site_address, ".") > 0 then parse var site_address dnode "." dpoint
  214.         when left(site_address, 1)="." then parse var site_address "." dpoint
  215.         otherwise parse var site_address dnode "." dpoint
  216.     end
  217.  
  218.     if ddomain="" | ddomain='DDOMAIN' then cfgaddress=GetClip('HOST.ADDRESS.'||def_domain)
  219.         else cfgaddress=GetClip('HOST.ADDRESS.'||ddomain)
  220.     parse var cfgaddress zone ":" net "/" node "." point
  221.     if dpoint=""|dpoint='DPOINT'then dpoint=0
  222.     if dnet =""|dnet ='DNET' then dnet=net
  223.     if dnode=""|dnode='DNODE' then dnode=node
  224.     if dzone=""|dzone='DZONE' then dzone=zone
  225.     if ddomain=""|ddomain='DDOMAIN' then do
  226.         ddomain=0
  227.         x=find(dl,z)
  228.         if x~=0 then ddomain=word(dl,x-1)
  229.         if ddomain=0 then ddomain=def_domain
  230.     end
  231.  
  232.     if ~datatype(dzone,'n')|~datatype(dnet,'n')|~datatype(dnode,'n')|~datatype(dpoint,'n') then do
  233.         call PutLog('make5d: Invalid address ['site_address']',50,10)
  234.         return 0
  235.     end
  236. return(ddomain'#'dzone':'dnet'/'dnode'.'dpoint)
  237.  
  238. myadr:
  239.     domain=upper(arg(1))
  240.     myaddress=GetClip('HOST.ADDRESS.'domain)  
  241.     parse var myaddress zone ":" net "/" node "." point
  242. return zone':'net'/'node'.'point
  243.  
  244.  /* a useful procedure by Walt Sullivan    */
  245. dequote:
  246.     parse arg thing
  247.      parse var thing '"' unq_thing '"'
  248.      if unq_thing ~="" then return unq_thing
  249. return thing
  250.  
  251. PutLog:  procedure expose log script
  252.     if arg(3) < GetClip('STATUSLEVEL') then say arg(1)
  253.     if arg(2) > GetClip('LOGLEVEL') then return 0
  254.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  255. return 0
  256.  
  257. cleanup:
  258. return 0
  259.  
  260. /*  Error handling */
  261. break_c:
  262. break_d:
  263.     call PutLog('User abort',10,10)
  264.     call cleanup
  265.     exit 10
  266. novalue: 
  267.         call template_oops "Novalue" sigl
  268. syntax:
  269.         call template_oops "Syntax(RC="||RC||")" sigl RC
  270. failure:
  271.         call template_oops "Failure(RC="||RC||")" sigl
  272. ioerr:
  273.         call template_oops "IOErr" sigl 
  274. halt:
  275.         call template_oops "Halt" sigl 
  276.  
  277. template_oops:
  278.         parse arg what badline code
  279.         if code ~="" then call PutLog('ERR: Line' badline what errortext(code),10,10)
  280.             else call PutLog('ERR: Line 'badline what,10,10)
  281.         call cleanup
  282.         exit(40)
  283. /**/
  284.  
  285. usage:
  286.     say script sv' by Robert Williamson'
  287.     say '   EchoTagName[@domain] InputFile "Origin Name" "Destination Name" Subject'
  288.     say '       where echotagname must be a valid TAGNAME'
  289.     say '       The EchoMail message will be placed in your inbound directory'
  290.     say '       for your default domain or the requested domain and imported'
  291.     say '   Note:'
  292.     say '   When called from another rexx script, double quotes should be quoted'
  293.     say '   with single quotes.'
  294.     say ''
  295. exit 0
  296.  
  297.